COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Only measure TAK
C00007 ENDMK
C⊗;
;;; Only measure TAK
(declare (fasload meter)
	 (setq meter:count-only t))
(declare 
 (fixnum (tak fixnum fixnum fixnum))
 (fixnum (trtak fixnum fixnum fixnum))
 (fixnum (btak fixnum fixnum fixnum))
 (fixnum (btak2 fixnum fixnum fixnum)))

(meter:meter tak
	     (meter
	      (defun tak (x y z)
		     (mn "Calls to TAK" TAK 1)
		     (cond ((not (< y x))	;x≤y
			    z)
			   (t (mn "1-'s" sub1 3)
			      (tak (tak (1- x) y z)
				   (tak (1- y) z x)
				   (tak (1- z) x y)))))))

(defun tak-dcl (x y z)
       (cond ((not (< y x))	;x≤y
	      z)
	     (t (tak-dcl (tak-dcl (1- x) y z)
		     (tak-dcl (1- y) z x)
		     (tak-dcl (1- z) x y))))) 

(defun trtak (x y z)
       (prog ()
	     tak
	     (cond ((not (< y x))
		    (return z))
		   (t (let ((a (tak (1- x) y z))
			    (b (tak (1- y) z x)))
			   (setq z (tak (1- z) x y))
			   (setq x a y b)(go tak))))))

(defun btak (x y z)
 (prog ()
       (cond ((not (< y x))
	      (return z)))
       tak2
       (let ((a (let ((c (1- x)))
		     (cond ((not (< y c)) z)
			   (t (btak2 c y z)))))
	     (b (let ((c (1- y)))
		     (cond ((not (< z c)) x)
			   (t (btak2 c z x)))))
	     (c (let ((c (1- z)))
		     (cond ((not (< x c)) y)
			   (t (btak2 c x y))))))
	    (cond ((not (< b a)) (return c))
		  (t (setq x a
			   y b
			   z c)
		     (go tak2))))))

(defun btak2 (x y z)
 (prog ()
       tak2
       (let ((a (let ((c (1- x)))
		     (cond ((not (< y c)) z)
			   (t (btak2 c y z)))))
	     (b (let ((c (1- y)))
		     (cond ((not (< z c)) x)
			   (t (btak2 c z x)))))
	     (c (let ((c (1- z)))
		     (cond ((not (< x c)) y)
			   (t (btak2 c x y))))))
	    (cond ((not (< b a)) (return c))
		  (t (setq x a
			   y b
			   z c)
		     (go tak2))))))

(defun btak-dcl (x y z)
 (prog ()
       (cond ((not (< y x))
	      (return z)))
       tak-dcl2
       (let ((a (let ((c (1- x)))
		     (cond ((not (< y c)) z)
			   (t (btak-dcl2 c y z)))))
	     (b (let ((c (1- y)))
		     (cond ((not (< z c)) x)
			   (t (btak-dcl2 c z x)))))
	     (c (let ((c (1- z)))
		     (cond ((not (< x c)) y)
			   (t (btak-dcl2 c x y))))))
	    (cond ((not (< b a)) (return c))
		  (t (setq x a
			   y b
			   z c)
		     (go tak-dcl2))))))

(defun btak-dcl2 (x y z)
 (prog ()
       tak-dcl2
       (let ((a (let ((c (1- x)))
		     (cond ((not (< y c)) z)
			   (t (btak-dcl2 c y z)))))
	     (b (let ((c (1- y)))
		     (cond ((not (< z c)) x)
			   (t (btak-dcl2 c z x)))))
	     (c (let ((c (1- z)))
		     (cond ((not (< x c)) y)
			   (t (btak-dcl2 c x y))))))
	    (cond ((not (< b a)) (return c))
		  (t (setq x a
			   y b
			   z c)
		     (go tak-dcl2))))))